home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvdmx.exe / TVGIZMA.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-16  |  16KB  |  636 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    tvGIZMA   --Turbo Vision Accessories        }
  5. {                            }
  6. {    Copyright (c) 1992  Randolph Beck        }
  7. {                P.O. Box  56-0487        }
  8. {                Orlando, FL 32856        }
  9. {                CIS:  72361,753        }
  10. {                            }
  11. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  12.  
  13. Unit tvGIZMA;
  14.  
  15. {$D-,B-,O+,R-,V-,X+ }
  16.  
  17. interface
  18.  
  19. uses
  20.     Dos, Crt, Objects, Drivers, Memory, Dialogs, Menus,
  21.     HistList, Views, App, MsgBox, Buffers, RSet, DmxGizma;
  22.  
  23. const
  24.     cmUserScreen    = cmDMX + 51;    { invokes User Screen }
  25.     cmToggleSound    = cmDMX + 52;    { toggles BeepOn }
  26.     cmToggleVideo    = cmDMX + 53;    { toggles video mode }
  27.     cmBeep        = cmDMX + 54;    { beeps if BeepOn is TRUE }
  28.  
  29.     BeepOn   : boolean     = TRUE;  { allows beeping from cmBeep event }
  30.  
  31.     SoundIndOn        = ' ON';    { On & Off must be the same length }
  32.     SoundIndOff        = 'OFF';
  33.     VideoIndHi        = '43/50';    { Hi & Low must be the same length }
  34.     VideoIndLow        = '   25';
  35.  
  36. type
  37.     PCursorDlg    = ^TCursorDlg;
  38.     TCursorDlg    =  OBJECT (TDialog)
  39.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  40.     end;
  41.  
  42.  
  43.     PTimeView  = ^TTimeView;
  44.     TTimeView  =  OBJECT (TView)
  45.     Hour,Min  : word;
  46.       constructor Init (var Bounds : TRect);
  47.       procedure Draw;  VIRTUAL;
  48.       procedure Update;  VIRTUAL;
  49.     end;
  50.  
  51.  
  52.     PAppA   = ^TAppA;
  53.     TAppA   =  OBJECT (TProgram)
  54.     Clock        : PTimeView;
  55.         SoundInd    : pstring;
  56.         VideoInd    : pstring;
  57.       constructor Init;
  58.       destructor  Done;  VIRTUAL;
  59.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  60.       procedure Idle;  VIRTUAL;
  61.       procedure InitClock;  VIRTUAL;
  62.       function  NewSoundItem (AHelpCtx : word; ANext : PMenuItem) : PMenuItem;
  63.       function  NewVideoItem (AHelpCtx : word; ANext : PMenuItem) : PMenuItem;
  64.       procedure OutOfMemory;  VIRTUAL;
  65.       private
  66.     KeptScreen : PVideoBuf;
  67.     Col,Row    : byte;
  68.     end;
  69.  
  70.  
  71.     PUserScreen  = ^TUserScreen;
  72.     TUserScreen  =  OBJECT (TScroller)
  73.       constructor Init (var Bounds : TRect; AHScrollBar,AVScrollBar : PScrollBar);
  74.       procedure Draw;  VIRTUAL;
  75.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  76.       function  Valid (Command : word) : boolean;  VIRTUAL;
  77.     end;
  78.  
  79.  
  80.   function  SParam (S : pstring;  Next : pointer) : pointer;
  81.   function  DParam (N : longint;  Next : pointer) : pointer;
  82.     { accessories for FormatStr() and MessageBox() procedures }
  83.  
  84.  
  85.   procedure AssignWinRect (var Bounds : TRect;  MaxX,MaxY : integer);
  86.     { assigns a rectangle to cascade into the desktop }
  87.  
  88.   function  InsertLine (Dialog : PDialog;  Col,Row,Width,Max : integer;
  89.             Fmt : boolean; ALabel : string; hlID : word) : PInputLine;
  90.     { inserts a TInputLine view with (optional) history list }
  91.  
  92.   function  InsertText (Dialog : PDialog; Col,Row : integer; AText : string) : PView;
  93.     { inserts a single-line standard text view }
  94.  
  95.   function  InsertView (Owner :PGroup; View :PView; Options :word) : pointer;
  96.     { sets a view's options and inserts it into an owner }
  97.  
  98.   function  NewVarItem (Name, Param : TMenuStr; var Ind : pstring;
  99.                         KeyCode, Command, AHelpCtx : word;
  100.                         Next : PMenuItem) : PMenuItem;
  101.     { creates a new menu item with a status indicator }
  102.  
  103.   function  NextWindowNumber  : integer;
  104.     { finds an unused window number }
  105.  
  106.   procedure TrimDialog (Window : PWindow);
  107.     { resizes a dialog window }
  108.  
  109.  
  110. implementation
  111.  
  112.  
  113.   { ══ Param Functions ═══════════════════════════════════════════════════ }
  114.  
  115. const    iparmax            = 15;  { maximum number of parameters - 1 }
  116.     ipar    : integer    = iparmax;
  117.  
  118. var    Apar    : array [0..iparmax] of pointer;
  119.  
  120.  
  121. function  SParam (S : pstring;  Next : pointer) : pointer;
  122. begin
  123.   {$IFOPT R+ }
  124.   If (ipar < 0) then RunError (201);
  125.   {$ENDIF }
  126.   If (Next = nil) then ipar := iparmax;
  127.   Apar [ipar] := S;
  128.   SParam := @Apar [ipar];
  129.   Dec (ipar);
  130. end;
  131.  
  132.  
  133. function  DParam (N : longint;  Next : pointer) : pointer;
  134. begin
  135.   {$IFOPT R+ }
  136.   If (ipar < 0) then RunError (201);
  137.   {$ENDIF }
  138.   If (Next = nil) then ipar := iparmax;
  139.   Apar [ipar] := pointer (N);
  140.   DParam := @Apar [ipar];
  141.   Dec (ipar);
  142. end;
  143.  
  144.  
  145.   { ══════════════════════════════════════════════════════════════════════ }
  146.  
  147.  
  148. procedure AssignWinRect (var Bounds : TRect;  MaxX,MaxY : integer);
  149. var P : PView;
  150. begin
  151.   DeskTop^.GetExtent (Bounds);
  152.   If (MaxX <= 0) then MaxX := Bounds.B.X;
  153.   If (MaxY <= 0) then MaxY := Bounds.B.Y;
  154.   If (Bounds.B.X > MaxX) then Bounds.B.X := MaxX;
  155.   If (Bounds.B.Y > MaxY) then Bounds.B.Y := MaxY;
  156.   P := DeskTop^.Current;
  157.   If (P^.Options and ofTileable = 0) then P := nil;
  158.   If (P <> nil) then
  159.     begin
  160.     Bounds.Move (succ (P^.Origin.X), succ (P^.Origin.Y));
  161.     If (Bounds.B.X > DeskTop^.Size.X) then Bounds.B.X := DeskTop^.Size.X;
  162.     If (Bounds.B.Y > DeskTop^.Size.Y) then Bounds.B.Y := DeskTop^.Size.Y;
  163.     If (Bounds.B.X - Bounds.A.X < MinWinSize.X) or
  164.        (Bounds.B.Y - Bounds.A.Y < MinWinSize.Y) then
  165.       begin
  166.       If (MaxX >= DeskTop^.Size.X) then MaxX := pred (DeskTop^.Size.X);
  167.       Bounds.A.X := 1;
  168.       Bounds.A.Y := 0;
  169.       Bounds.B.X := succ (MaxX);
  170.       Bounds.B.Y := MaxY;
  171.       end;
  172.     end;
  173. end;
  174.  
  175.  
  176.   { ══════════════════════════════════════════════════════════════════════ }
  177.  
  178.  
  179. function  InsertLine (Dialog : PDialog;  Col,Row,Width,Max : integer;
  180.               Fmt : boolean; ALabel : string;  hlID : word) : PInputLine;
  181. var  i  : integer;
  182.      R  : TRect;
  183.      B  : PInputLine;
  184. begin
  185.   With Dialog^ do
  186.     begin
  187.     i  := succ (CStrLen (ALabel));
  188.     R.Assign (Col, Row, Col + Width + 2, succ (Row));
  189.     If (ALabel <> '') then
  190.       begin
  191.       If Fmt then R.Move (1, 1) else R.Move (i, 0);
  192.       end;
  193.     B  := New (PInputLine, Init (R, Max));
  194.     Insert (B);
  195.     If (hlID > 0) then
  196.       begin
  197.       R.A.X := R.A.X + Width + 2;
  198.       R.B.X := R.A.X + 3;
  199.       Insert (New (PHistory, Init (R, B, hlID)));
  200.       end;
  201.     If (ALabel <> '') then
  202.       begin
  203.       R.Assign (Col, Row, Col + i, succ (Row));
  204.       Insert (New (PLabel, Init (R, ALabel, B)));
  205.       end;
  206.     end;
  207.   InsertLine := B;
  208. end;
  209.  
  210.  
  211.   { ══════════════════════════════════════════════════════════════════════ }
  212.  
  213.  
  214. function  InsertText (Dialog : PDialog; Col,Row : integer; AText : string) : PView;
  215. var  R : TRect;
  216.      B : PView;
  217. begin
  218.   With Dialog^ do
  219.     begin
  220.     R.Assign (Col, Row, Col + length (AText), succ (Row));
  221.     B  := New (PStaticText, Init (R, AText));
  222.     Insert (B);
  223.     end;
  224.   InsertText := B;
  225. end;
  226.  
  227.  
  228.   { ══════════════════════════════════════════════════════════════════════ }
  229.  
  230.  
  231. function  InsertView (Owner :PGroup; View :PView; Options :word) : pointer;
  232. begin
  233.   If (View <> nil) then
  234.     begin
  235.     View^.Options := View^.Options or Options;
  236.     If (Owner <> nil) then Owner^.Insert (View);
  237.     end;
  238.   InsertView := View;
  239. end;
  240.  
  241.  
  242.   { ══════════════════════════════════════════════════════════════════════ }
  243.  
  244.  
  245. function  NewVarItem (Name, Param : TMenuStr; var Ind : pstring;
  246.                       KeyCode, Command, AHelpCtx : word;
  247.                       Next : PMenuItem) : PMenuItem;
  248. var  P : PMenuItem;
  249. begin
  250.   P := NewItem (Name,Param, KeyCode,Command,AHelpCtx, Next);
  251.   Ind := P^.Param;
  252.   NewVarItem := P;
  253. end;
  254.  
  255.  
  256.   { ══════════════════════════════════════════════════════════════════════ }
  257.  
  258.  
  259. function  NextWindowNumber  : integer;
  260. var  wn : integer;
  261.  
  262.     function  UsedWN (P : PWindow) : boolean;  far;
  263.     begin
  264.       UsedWN := (P^.Number = wn) and (P <> PWindow (DeskTop^.Background))
  265.     end;
  266.  
  267. begin
  268.   wn := 0;
  269.   Repeat Inc (wn) until (DeskTop^.FirstThat (@UsedWN) = nil);
  270.   NextWindowNumber := wn;
  271. end;
  272.  
  273.  
  274.   { ══════════════════════════════════════════════════════════════════════ }
  275.  
  276.  
  277. procedure TrimDialog (Window : PWindow);
  278. var  B    : TRect;
  279.      MinX : integer;
  280.  
  281.     procedure FindBounds (P : PView);  far;
  282.     begin
  283.       If (PFrame (P) <> Window^.Frame) and (P^.GetState (sfVisible)) then
  284.         begin
  285.         If (P^.Origin.X < MinX) then MinX := P^.Origin.X;
  286.         If (P^.Options and ofCenterX <